home *** CD-ROM | disk | FTP | other *** search
/ Software Vault: The Gold Collection / Software Vault - The Gold Collection (American Databankers) (1993).ISO / cdr47 / 335_04.zip / FRAPSUB.C < prev    next >
C/C++ Source or Header  |  1993-04-13  |  22KB  |  1,117 lines
  1. /*
  2. HEADER:     ;
  3. TITLE:         Frankenstein Cross Assemblers;
  4. VERSION:     2.0;
  5. DESCRIPTION: "    Reconfigurable Cross-assembler producing Intel (TM)
  6.         Hex format object records.  ";
  7. SYSTEM:     UNIX, MS-Dos ;
  8. FILENAME:     frapsub.c ;
  9. WARNINGS:     "This software is in the public domain.  
  10.         Any prior copyright claims are relinquished.  
  11.  
  12.         This software is distributed with no warranty whatever.  
  13.         The author takes no responsibility for the consequences 
  14.         of its use.  "  ;
  15. SEE-ALSO:     frasmain.c;
  16. AUTHORS:     Mark Zenier;
  17. */
  18.  
  19. /*
  20.     description    Parser phase utility routines
  21.     History        September 1987
  22.             September 14, 1990 Dosify, 6 char unique names
  23. */
  24.  
  25. #include "fragcon.h"
  26. #include <stdio.h>
  27. #include "frasmdat.h"
  28.  
  29. #define STRALLOCSZ 4096
  30.  
  31.     local char *currstr;
  32.  
  33. char * savestring(stx, len)
  34.     char *stx;
  35.     int len;
  36. /*
  37.     description    save a character string in permanent (interpass) memory
  38.     parameters    the string and its length
  39.     globals     the string pool
  40.     return        a pointer to the saved string
  41. */
  42. {
  43.     char * rv;
  44.     static int savestrleft = 0;
  45.  
  46.     if( savestrleft < (len+1))
  47.     {
  48.         if((currstr = malloc(STRALLOCSZ)) == (char *)NULL)
  49.         {
  50.             frafatal("cannot allocate string storage");
  51.         }
  52.         savestrleft = STRALLOCSZ;
  53.     }
  54.  
  55.     savestrleft -= (len+1);
  56.  
  57.     rv = currstr;
  58.     for(; len > 0; len--)
  59.         *currstr++ = *stx++;
  60.     *currstr++ = '\0';
  61.  
  62.     return rv;
  63. }
  64.  
  65. /* expression node operations */
  66.  
  67. /* expression tree element */
  68. struct etelem
  69. {
  70.     int    evs;
  71.     int    op;
  72.     int    left, right;
  73.     long    val;
  74.     struct symel *sym;
  75. };
  76.  
  77. #define NUMENODE INBUFFSZ
  78. struct etelem enode[NUMENODE];
  79.  
  80. local int nextenode = 1;
  81.  
  82. /* non general, one exprlist or stringlist per line */
  83. int nextexprs = 0;
  84. int nextstrs = 0;
  85.  
  86. clrexpr()
  87. /*
  88.     description    clear out the stuff used for each line
  89.             the temporary string pool
  90.             the expression tree storage pool
  91.             the string and expression lists
  92. */
  93. {
  94.     nextenode = 1;
  95.     nextexprs = nextstrs = 0;
  96. }
  97.  
  98. exprnode(swact, left, op, right, value, symbol)
  99.     int swact, left, op, right;
  100.     long value;
  101.     struct symel * symbol;
  102. /*
  103.     description    add an element to the expression tree pool
  104.     parameters    swact, the action performed by the switch in
  105.                 the polish conversion routine, the category
  106.                 of the expression node.
  107.             left, right  the subscripts of the decendent nodes
  108.                     of the expression tree element
  109.             op, the operation to preform
  110.             value, a constant value (maybe)
  111.             symbol, a pointer to a symbol element (maybe)
  112.     globals        the next available table element
  113.     return        the subscript of the expression node
  114. */
  115. {
  116.     if(nextenode >= NUMENODE)
  117.     {
  118.         frafatal("excessive number of subexpressions");
  119.     }
  120.  
  121.     enode [nextenode].evs = swact;
  122.     enode [nextenode].left = left;
  123.     enode [nextenode].op = op;
  124.     enode [nextenode].right = right;
  125.     enode [nextenode].val = value;
  126.     enode [nextenode].sym = symbol;
  127.  
  128.     return nextenode ++;
  129. }
  130.  
  131. int nextsymnum = 1;
  132.  
  133. local struct symel *syallob;
  134. #define SYELPB 512
  135. local int nxtsyel = SYELPB;
  136.  
  137. struct symel *allocsym()
  138. /*
  139.     description    allocate a symbol table element, and allocate
  140.             a block if the current one is empty.  A fatal
  141.             error if no more space can be gotten
  142.     globals        the pointer to the current symbol table block
  143.             the count of elements used in the block
  144.     return        a pointer to the symbol table element
  145. */
  146. {
  147.  
  148.     if(nxtsyel >= SYELPB)
  149.     {
  150.         if( (syallob = (struct symel *)calloc(
  151.             SYELPB , sizeof(struct symel)))
  152.          == (struct symel *)NULL)
  153.         {
  154.             frafatal("cannot allocate symbol space");
  155.         }
  156.  
  157.         nxtsyel = 0;
  158.     }
  159.  
  160.     return &syallob[nxtsyel++];
  161. }
  162.  
  163.  
  164. #define SYHASHOFF 13
  165. #define SYHASHSZ 1023
  166.  
  167. int syhash(str)
  168.     register char *str;
  169. /*
  170.     description    produce a hash index from a character string for
  171.             the symbol table.
  172.     parameters     a character string
  173.     return        an integer related in some way to the character string
  174. */
  175. {
  176.     unsigned rv = 0;
  177.     register int offset = 1;
  178.     register int c;
  179.  
  180.     while((c = *(str++)) > 0)
  181.     {
  182.         rv += (c - ' ') * offset;
  183.         offset *= SYHASHOFF;
  184.     }
  185.  
  186.     return rv % SYHASHSZ;
  187. }
  188.  
  189. local struct symel * (shashtab[SYHASHSZ]);
  190.  
  191. static struct symel *getsymslot(str)
  192.     char * str;
  193. /*
  194.     description    find an existing symbol in the symbol table, or
  195.             allocate an new element if the symbol doen't exist.
  196.             action: hash the string
  197.                 if there are no symbols for the hash value
  198.                     create one for this string
  199.                 otherwise
  200.                 scan the linked list until the symbol is 
  201.                 found or the end of the list is found
  202.                 if the symbol was found
  203.                     exit
  204.                 if the symbol was not found, allocate and
  205.                 add at the end of the linked list
  206.                 fill out the symbol
  207.     parameters    the character string 
  208.     globals        all the symbol table
  209.     return        a pointer to the symbol table element for this
  210.             character string
  211. */
  212. {
  213.     struct symel *currel, *prevel;
  214.     int hv;
  215.  
  216.     if( (currel = shashtab[hv = syhash(str)])
  217.         == (struct symel *)NULL)
  218.     {
  219.         shashtab[hv] = currel = allocsym();
  220.     }
  221.     else
  222.     {
  223.         do  {
  224.             if(strcmp(currel -> symstr, str) == 0)
  225.             {
  226.                 return currel;
  227.             }
  228.             else
  229.             {
  230.                 prevel = currel;
  231.                 currel = currel -> nextsym;
  232.             }
  233.         } while( currel != (struct symel *)NULL);
  234.  
  235.         prevel -> nextsym = currel = allocsym();
  236.     }
  237.  
  238.     currel -> symstr = savestring(str, strlen(str));
  239.     currel -> nextsym = (struct symel *)NULL;
  240.     currel -> tok = 0;
  241.     currel -> value = 0;
  242.     currel -> seg = SSG_UNUSED;
  243.  
  244.     return currel;
  245. }
  246.  
  247. struct symel * symbentry(str,toktyp)
  248.     char * str;
  249.     int toktyp;
  250. /*
  251.     description    find or add a nonreserved symbol to the symbol table
  252.     parameters    the character string
  253.             the syntactic token type for this charcter string
  254.                 (this is a parameter so the routine doesn't
  255.                 have to be recompiled since the yacc grammer
  256.                 provides the value)
  257.     globals        the symbol table in all its messy glory
  258.     return        a pointer to the symbol table element
  259. */
  260. {
  261.     struct symel * rv;
  262.  
  263.     rv = getsymslot(str);
  264.  
  265.     if(rv -> seg == SSG_UNUSED)
  266.     {
  267.         rv -> tok = toktyp;
  268.         rv -> symnum = nextsymnum ++;
  269.         rv -> seg = SSG_UNDEF;
  270.     }
  271.  
  272.     return rv;
  273. }
  274.  
  275. void reservedsym(str, tok, value)
  276.     char * str;
  277.     int tok;
  278.     int value;
  279. /*
  280.     description    add a reserved symbol to the symbol table.
  281.     parameters    the character string, must be a constant as
  282.             the symbol table does not copy it, only point to it.
  283.             The syntactic token value.
  284.             The associated value of the symbol.
  285. */
  286. {
  287.     struct symel * tv;
  288.  
  289.     tv = getsymslot(str);
  290.  
  291.     if(tv -> seg != SSG_UNUSED)
  292.     {
  293.         frafatal("cannot redefine reserved symbol");
  294.     }
  295.  
  296.     tv -> symnum = 0;
  297.     tv -> tok = tok;
  298.     tv -> seg = SSG_RESV;
  299.     tv -> value = value;
  300.  
  301. }
  302.  
  303. buildsymbolindex()
  304. /*
  305.     description    allocate and fill an array that points to each
  306.             nonreserved symbol table element, used to reference
  307.             the symbols in the intermediate file, in the output
  308.             pass.
  309.     globals        the symbol table
  310. */
  311. {
  312.     int hi;
  313.     struct symel *curr;
  314.  
  315.     if((symbindex = (struct symel **)calloc((unsigned)nextsymnum, 
  316.             sizeof (struct symel *))) == (struct symel **)NULL)
  317.     {
  318.         frafatal(" unable to allocate symbol index");
  319.     }
  320.  
  321.     for(hi = 0; hi < SYHASHSZ; hi++)
  322.     {
  323.         if( (curr = shashtab[hi]) != SYMNULL)
  324.         {
  325.             do  {
  326.                 if( curr -> symnum)
  327.                     symbindex[curr -> symnum] = curr;
  328.  
  329.                 curr = curr -> nextsym;
  330.             }  while(curr != SYMNULL);
  331.         }
  332.     }
  333. }
  334.  
  335. /* opcode symbol table */
  336.  
  337. #define OPHASHOFF 13
  338. #define OPHASHSZ 1023
  339.  
  340. local int ohashtab[OPHASHSZ];
  341.  
  342. setophash()
  343. /*
  344.     description    set up the linked list hash table for the
  345.             opcode symbols 
  346.     globals        the opcode hash table
  347.             the opcode table
  348. */
  349. {
  350.     int opn, pl, hv;
  351.  
  352.         /* optab[0] is reserved for the "invalid" entry */
  353.         /*  opcode subscripts range from 0 to numopcode - 1 */
  354.     for(opn = 1; opn < gnumopcode; opn++)
  355.     {
  356.         hv = opcodehash(optab[opn].opstr);
  357.  
  358.         if( (pl = ohashtab[hv]) == 0)
  359.         {
  360.             ohashtab[hv] = opn;
  361.         }
  362.         else
  363.         {
  364.             while( ophashlnk[pl] != 0)
  365.             {
  366.                 pl = ophashlnk[pl];
  367.             }
  368.  
  369.             ophashlnk[pl] = opn;
  370.             ophashlnk[opn] = 0;
  371.         }
  372.     }
  373. }
  374.  
  375.  
  376. int findop(str)
  377.     char *str;
  378. /*
  379.     description    find an opcode table subscript
  380.     parameters    the character string
  381.     globals        the opcode hash linked list table
  382.             the opcode table
  383.     return        0 if not found
  384.             the subscript of the matching element if found
  385. */
  386. {
  387.     int ts;
  388.  
  389.     if( (ts = ohashtab[opcodehash(str)]) == 0)
  390.     {
  391.         return 0;
  392.     }
  393.  
  394.     do  {
  395.         if(strcmp(str,optab[ts].opstr) == 0)
  396.         {
  397.             return ts;
  398.         }
  399.         else
  400.         {
  401.             ts = ophashlnk[ts];
  402.         }
  403.     } while (ts != 0);
  404.  
  405.     return 0;
  406. }
  407.  
  408.  
  409. int opcodehash(str)
  410.     char *str;
  411. /*
  412.     description    hash a character string
  413.     return        an integer related somehow to the character string
  414. */
  415. {
  416.     unsigned rv = 0;
  417.     int offset = 1, c;
  418.  
  419.     while((c = *(str++)) > 0)
  420.     {
  421.         rv += (c - ' ') * offset;
  422.         offset *= OPHASHOFF;
  423.     }
  424.  
  425.     return rv % OPHASHSZ;
  426. }
  427.  
  428.  
  429. char * findgen(op, syntax, crit)
  430.     int    op, syntax, crit;
  431. /*
  432.     description    given the subscript of the opcode table element,
  433.             find the instruction generation string for the
  434.             opcode with the given syntax and fitting the
  435.             given criteria.  This implement a sparse matrix
  436.             for  the dimensions [opcode, syntax] and then
  437.             points to a list of generation elements that
  438.             are matched to the criteria (binary set) that
  439.             are provided by the action in the grammer for that
  440.             specific syntax.
  441.     parameters    Opcode table subscript
  442.                 note 0 is the value which points to an
  443.                 syntax list that will accept anything
  444.                 and gives the invalid instruction error
  445.             Syntax, a selector, a set member
  446.             Criteria, a integer used a a group of bit sets
  447.     globals        the opcode table, the opcode syntax table, the
  448.             instruction generation table
  449.     return        a pointer to a character string, either a
  450.             error message, or the generation string for the
  451.             instruction
  452. */
  453. {
  454.     int    sys = optab[op].subsyn, stc, gsub = 0, dctr;
  455.  
  456.     for(stc = optab[op].numsyn; stc > 0; stc--)
  457.     {
  458.         if( (ostab[sys].syntaxgrp & syntax) != 0)
  459.         {
  460.             gsub = ostab[sys].gentabsub;
  461.             break;
  462.         }
  463.         else
  464.             sys++;
  465.     }
  466.  
  467.     if(gsub == 0)
  468.         return ignosyn;
  469.  
  470.     for(dctr = ostab[sys].elcnt; dctr > 0; dctr--)
  471.     {
  472.         if( (igtab[gsub].selmask & crit) == igtab[gsub].criteria)
  473.         {
  474.             return igtab[gsub].genstr;
  475.         }
  476.         else
  477.         {
  478.             gsub++;
  479.         }
  480.     }
  481.  
  482.     return ignosel;
  483. }
  484.  
  485.  
  486. genlocrec(seg, loc)
  487.     int seg;
  488.     long loc;
  489. /*
  490.     description    output to the intermediate file, a 'P' record
  491.             giving the current location counter.  Segment
  492.             is not used at this time.
  493. */
  494. {
  495.     fprintf(intermedf, "P:%x:%lx\n", seg, loc);
  496. }
  497.  
  498. #define GSTR_PASS 0
  499. #define GSTR_PROCESS 1
  500.  
  501. local char *goutptr, goutbuff[INBUFFSZ] = "D:";
  502.  
  503. void goutch(ch)
  504.     char ch;
  505. /*
  506.     description    put a character in the intermediate file buffer
  507.             for 'D' data records
  508.     globals        the buffer, its current position pointer
  509. */
  510. {
  511.     if(goutptr < &goutbuff[INBUFFSZ-1])
  512.     {
  513.         *goutptr ++ = ch;
  514.     }
  515.     else
  516.     {
  517.         goutbuff[INBUFFSZ-1] = '\0';
  518.         goutptr = &goutbuff[INBUFFSZ]; 
  519.         fraerror("overflow in instruction generation");
  520.     }
  521. }
  522.  
  523.  
  524. gout2hex(inv)
  525.     int inv;
  526. /*
  527.     description    output to the 'D' buffer, a byte in ascii hexidecimal
  528. */
  529. {
  530.     goutch(hexch( inv>>4 ));
  531.     goutch(hexch( inv ));
  532. }
  533.  
  534.  
  535. goutxnum(num)
  536.     unsigned long num;
  537. /*
  538.     description    output to the 'D' record buffer a long integer in
  539.             hexidecimal
  540. */
  541. {
  542.     if(num > 15)
  543.         goutxnum(num>>4);
  544.     goutch(hexch((int) num ));
  545. }
  546.  
  547.  
  548. int geninstr(str)
  549.     register char * str;
  550. /*
  551.     description    Process an instruction generation string, from
  552.             the parser, into a polish form expression line
  553.             in a 'D' record in the intermediate file, after
  554.             merging in the expression results.
  555.     parameters    the instruction generation string
  556.     globals        the evaluation results 
  557.                 evalr[].value    a numeric value known at
  558.                         the time of the first pass
  559.                 evalr[].exprstr  a polish form expression
  560.                         derived from the expression
  561.                         parse tree, to be evaluated in
  562.                         the output phase.
  563.     return        the length of the instruction (machine code bytes)
  564. */
  565. {
  566.     int len = 0;
  567.     int state = GSTR_PASS;
  568.     int innum = 0;
  569.  
  570.     register char *exp;
  571.  
  572.     goutptr = &goutbuff[2];
  573.  
  574.     while( *str != '\0')
  575.     {
  576.         if(state == GSTR_PASS)
  577.         {
  578.             switch(*str)
  579.             {
  580.             case IG_START:
  581.                 state = GSTR_PROCESS;
  582.                 innum = 0;
  583.                 str++;
  584.                 break;
  585.  
  586.             case IFC_EMU8:
  587.             case IFC_EMS7:
  588.                 len++;
  589.                 goutch(*str++);
  590.                 break;
  591.  
  592.             case IFC_EM16:
  593.             case IFC_EMBR16:
  594.                 len += 2;
  595.                 goutch(*str++);
  596.                 break;
  597.  
  598.             default:
  599.                 goutch(*str++);
  600.                 break;
  601.             }
  602.         }
  603.         else
  604.         {
  605.             switch(*str)
  606.             {
  607.             case IG_END:
  608.                 state = GSTR_PASS;
  609.                 str++;
  610.                 break;
  611.             
  612.             case '0':
  613.             case '1':
  614.             case '2':
  615.             case '3':
  616.             case '4':
  617.             case '5':
  618.             case '6':
  619.             case '7':
  620.             case '8':
  621.             case '9':
  622.                 innum = (innum << 4) + (*str++) - '0';
  623.                 break;
  624.             
  625.             case 'a':
  626.             case 'b':
  627.             case 'c':
  628.             case 'd':
  629.             case 'e':
  630.             case 'f':
  631.                 innum = (innum << 4) + (*str++) - 'a' + 10;
  632.                 break;
  633.             
  634.             case 'A':
  635.             case 'B':
  636.             case 'C':
  637.             case 'D':
  638.             case 'E':
  639.             case 'F':
  640.                 innum = (innum << 4) + (*str++) - 'A' + 10;
  641.                 break;
  642.             
  643.             case IG_CPCON:
  644.                 goutxnum((unsigned long)evalr[innum].value);
  645.                 innum = 0;
  646.                 str++;
  647.                 break;
  648.  
  649.             case IG_CPEXPR:
  650.                 exp = &evalr[innum].exprstr[0];
  651.                 innum = 0;
  652.                 while(*exp != '\0')
  653.                     goutch(*exp++);
  654.                 str++;
  655.                 break;
  656.             
  657.             case IG_ERROR:
  658.                 fraerror(++str);
  659.                 return 0;
  660.             
  661.             default:
  662.                 fraerror(
  663.                 "invalid char in instruction generation");
  664.                 break;
  665.             }
  666.         }
  667.     }
  668.  
  669.     if(goutptr > &goutbuff[2])
  670.     {
  671.         goutch('\n');
  672.         fwrite(goutbuff,sizeof (char), goutptr - &goutbuff[0], 
  673.             intermedf);
  674.     }
  675.  
  676.     return len;
  677. }
  678.  
  679. int     chtnxalph = 1, *chtcpoint = (int *)NULL, *chtnpoint = (int *)NULL;
  680.  
  681. int chtcreate()
  682. /*
  683.     description    allocate and initialize a character translate
  684.             table
  685.     return        0 for error, subscript into chtatab to pointer
  686.             to the allocated block
  687. */
  688. {
  689.     int *trantab, cnt;
  690.  
  691.     if(chtnxalph >= NUM_CHTA)
  692.         return 0; /* too many */
  693.  
  694.     if( (trantab =  (int *)calloc(512, sizeof (int))) == (int *) NULL)
  695.         return 0;
  696.  
  697.     for(cnt = 0; cnt < 512; cnt++)
  698.         trantab[cnt] = -1;
  699.     
  700.     chtatab[chtnxalph] = chtnpoint = trantab;
  701.  
  702.     return chtnxalph++;
  703. }
  704.  
  705.  
  706. int chtcfind(chtab, sourcepnt, tabpnt, numret)
  707. /*
  708.     description    find a character in a translate table
  709.     parameters    pointer to translate table
  710.             pointer to pointer to input string
  711.             pointer to return value integer pointer
  712.             pointer to numeric return
  713.     return        status of search
  714. */
  715.     int *chtab;
  716.     char **sourcepnt; 
  717.     int **tabpnt;
  718.     int *numret;
  719. {
  720.     int numval, *valaddr;
  721.     char *sptr, cv;
  722.  
  723.     sptr = *sourcepnt;
  724.  
  725.     switch( cv = *sptr)
  726.     {
  727.     case '\0':
  728.         return CF_END;
  729.  
  730.     default:
  731.         if( chtab == (int *)NULL)
  732.         {
  733.             *numret = *sptr;
  734.             *sourcepnt = ++sptr;
  735.             return CF_NUMBER;
  736.         }
  737.         else
  738.         {
  739.             valaddr = &(chtab[cv & 0xff]);
  740.             *sourcepnt = ++sptr;
  741.             *tabpnt = valaddr;
  742.             return (*valaddr == -1) ?
  743.                 CF_UNDEF : CF_CHAR;
  744.         }
  745.         
  746.     case '\\':
  747.         switch(cv =  *(++sptr) )
  748.         {
  749.         case '\0':
  750.             *sourcepnt = sptr;
  751.             return CF_INVALID;
  752.         
  753.         case '\'':
  754.         case '\"':
  755.         case '\\':
  756.             if( chtab == (int *)NULL)
  757.             {
  758.                 *numret = *sptr;
  759.                 *sourcepnt = ++sptr;
  760.                 return CF_NUMBER;
  761.             }
  762.             else
  763.             {
  764.                 valaddr = &(chtab[(cv & 0xff) + 256]);
  765.                 *sourcepnt = ++sptr;
  766.                 *tabpnt = valaddr;
  767.                 return (*valaddr == -1) ?
  768.                     CF_UNDEF : CF_CHAR;
  769.             }
  770.  
  771.  
  772.         default:
  773.             if( chtab == (int *)NULL)
  774.             {
  775.                 *sourcepnt = ++sptr;
  776.                 return CF_INVALID;
  777.             }
  778.             else
  779.             {
  780.                 valaddr = &(chtab[(cv & 0xff) + 256]);
  781.                 *sourcepnt = ++sptr;
  782.                 *tabpnt = valaddr;
  783.                 return (*valaddr == -1) ?
  784.                     CF_UNDEF : CF_CHAR;
  785.             }
  786.  
  787.         case '0': case '1': case '2': case '3':
  788.         case '4': case '5': case '6': case '7':
  789.             {
  790.                 numval = cv - '0';
  791.                 cv =  *(++sptr);
  792.                 if(cv >= '0' && cv <= '7')
  793.                 {
  794.                     numval = numval * 8 +
  795.                         cv - '0';
  796.  
  797.                     cv = *(++sptr);
  798.                     if(cv >= '0' && cv <= '7')
  799.                     {
  800.                         numval = numval * 8 +
  801.                             cv - '0';
  802.                         ++sptr;
  803.                     }
  804.                 }
  805.                 *sourcepnt = sptr;
  806.                 *numret = numval & 0xff;
  807.                 return CF_NUMBER;
  808.             }
  809.  
  810.         case 'x':
  811.             switch(cv = *(++sptr))
  812.             {
  813.             case '0': case '1': case '2': case '3':
  814.             case '4': case '5': case '6': case '7':
  815.             case '8': case '9':
  816.                 numval = cv - '0';
  817.                 break;
  818.             
  819.             case 'a': case 'b': case 'c':
  820.             case 'd': case 'e': case 'f':
  821.                 numval = cv - 'a' + 10; 
  822.                 break;
  823.             
  824.             case 'A': case 'B': case 'C':
  825.             case 'D': case 'E': case 'F':
  826.                 numval = cv - 'A' + 10;
  827.                 break;
  828.             
  829.             default:
  830.                 *sourcepnt = sptr;
  831.                 return CF_INVALID;
  832.             }
  833.  
  834.             switch(cv = *(++sptr))
  835.             {
  836.             case '0': case '1': case '2': case '3':
  837.             case '4': case '5': case '6': case '7':
  838.             case '8': case '9':
  839.                 numval = numval * 16 + cv - '0';
  840.                 ++sptr;
  841.                 break;
  842.             
  843.             case 'a': case 'b': case 'c': 
  844.             case 'd': case 'e': case 'f':
  845.                 numval = numval * 16 + cv - 'a' + 10; 
  846.                 ++sptr;
  847.                 break;
  848.             
  849.             case 'A': case 'B': case 'C':
  850.             case 'D': case 'E': case 'F':
  851.                 numval = numval * 16 + cv - 'A' + 10;
  852.                 ++sptr;
  853.                 break;
  854.             
  855.             default:
  856.                 break;
  857.             }
  858.  
  859.             *sourcepnt = sptr;
  860.             *numret = numval;
  861.             return CF_NUMBER;
  862.         }
  863.     }
  864. }
  865.  
  866. int chtran(sourceptr)
  867.     char **sourceptr;
  868. {
  869.     int numval;
  870.     int *retptr;
  871.     char *beforeptr = *sourceptr;
  872.  
  873.     switch(chtcfind(chtcpoint, sourceptr, &retptr, &numval))
  874.     {
  875.     case CF_END:
  876.     default:
  877.         return 0;
  878.     
  879.     case CF_INVALID:
  880.         fracherror("invalid character constant", beforeptr, *sourceptr);
  881.         return 0;
  882.  
  883.     case CF_UNDEF:
  884.         fracherror("undefined character value", beforeptr, *sourceptr);
  885.         return 0;
  886.  
  887.     case CF_NUMBER:
  888.         return numval;
  889.  
  890.     case CF_CHAR:
  891.         return *retptr;
  892.     }
  893. }
  894.  
  895.  
  896. int genstring(str)
  897.     char *str;
  898. /*
  899.     description    Produce 'D' records for a ascii string constant
  900.             by chopping it up into lengths that will fit
  901.             in the intermediate file
  902.     parameters    a character string
  903.     return        the length of the string total (machine code bytes)
  904. */
  905. {
  906. #define STCHPERLINE 20
  907.     int rvlen = 0, linecount;
  908.  
  909.     while(*str != '\0')
  910.     {
  911.         goutptr = &goutbuff[2];
  912.  
  913.         for( linecount = 0; 
  914.             linecount < STCHPERLINE && *str != '\0';
  915.             linecount++)
  916.         {
  917.             gout2hex(chtran(&str));
  918.             goutch(IFC_EMU8);
  919.             rvlen++;
  920.         }
  921.  
  922.         if(goutptr > &goutbuff[2])
  923.         {
  924.             goutch('\n');
  925.             fwrite(goutbuff,sizeof (char), goutptr - &goutbuff[0], 
  926.                 intermedf);
  927.         }
  928.     }
  929.  
  930.     return rvlen;
  931. }
  932.     
  933. static char *pepolptr;
  934. static int pepolcnt;
  935. static long etop;
  936. static int    etopseg;
  937. #define STACKALLOWANCE 4 /* number of level used outside polish expr */
  938.  
  939. pevalexpr(sub, exn)
  940.     int sub, exn;
  941. /*
  942.     description    evaluate and save the results of an expression tree
  943.     parameters    the subscript to the evalr element to place the results
  944.             the subscript of the root node of a parser expression
  945.                 tree
  946.     globals        the evaluation results array
  947.             the expression stack
  948.             the expression tree node array
  949.     return        in evalr[sub].seg == SSG_UNDEF if the polish expression
  950.             conversion overflowed, or any undefined symbols were
  951.             referenced.
  952. */
  953. {
  954.     etop = 0;
  955.     etopseg = SSG_UNUSED;
  956.     estkm1p = &estk[0];
  957.  
  958.     pepolptr = &evalr[sub].exprstr[0];
  959.     pepolcnt = PPEXPRLEN;
  960.  
  961.     if(pepolcon(exn))
  962.     {
  963.         evalr[sub].seg = etopseg;
  964.         evalr[sub].value = etop;
  965.         polout('\0');
  966.     }
  967.     else
  968.     {
  969.         evalr[sub].exprstr[0] = '\0';
  970.         evalr[sub].seg = SSG_UNDEF;
  971.     }
  972. }
  973.  
  974. polout(ch)
  975.     char ch;
  976. /*
  977.     description    output a character to a evar[?].exprstr array
  978.     globals        parser expression to polish pointer pepolptr
  979. */
  980. {
  981.     if(pepolcnt > 1)
  982.     {
  983.         *pepolptr++ = ch;
  984.         pepolcnt --;
  985.     }
  986.     else
  987.     {
  988.         *pepolptr = '\0';
  989.         fraerror("overflow in polish expression conversion");
  990.     }
  991. }
  992.  
  993. polnumout(inv)
  994.     unsigned long inv;
  995. /*
  996.     description    output a long constant to a polish expression
  997. */
  998. {
  999.     if( inv > 15)
  1000.         polnumout(inv >> 4);
  1001.     polout(hexch((int) inv ));
  1002. }
  1003.  
  1004. pepolcon(esub)
  1005.     int esub;
  1006. /*
  1007.     description    convert an expression tree to polish notation
  1008.             and do a preliminary evaluation of the numeric value
  1009.             of the expression
  1010.     parameters    the subscript of an expression node
  1011.     globals        the expression stack
  1012.             the polish expression string in an evalr element
  1013.     return        False if the expression stack overflowed
  1014.  
  1015.             The expression stack top contains the
  1016.             value and segment for the result of the expression
  1017.             which are propgated along as numeric operators are
  1018.             evaluated.  Undefined references result in an
  1019.             undefined result.
  1020. */
  1021. {
  1022.     switch(enode[esub].evs)
  1023.     {
  1024.     case  PCCASE_UN:
  1025.         {
  1026.             if( ! pepolcon(enode[esub].left))
  1027.                 return FALSE;
  1028.  
  1029.             polout(enode[esub].op);
  1030.  
  1031.             switch(enode[esub].op)
  1032.             {
  1033. #include "fraeuni.h"
  1034.             }
  1035.         }
  1036.         break;
  1037.  
  1038.     case  PCCASE_BIN:
  1039.         {
  1040.             if( ! pepolcon(enode[esub].left))
  1041.                 return FALSE;
  1042.  
  1043.             polout(IFC_LOAD);
  1044.  
  1045.             if(estkm1p >= &estk[PESTKDEPTH-1-STACKALLOWANCE])
  1046.             {
  1047.                 fraerror("expression stack overflow");
  1048.                 return FALSE;
  1049.             }
  1050.  
  1051.             (++estkm1p)->v = etop;
  1052.             estkm1p -> s = etopseg;
  1053.             etopseg = SSG_UNUSED;    
  1054.             etop = 0;
  1055.  
  1056.             if( ! pepolcon(enode[esub].right))
  1057.                 return FALSE;
  1058.  
  1059.             polout(enode[esub].op);
  1060.  
  1061.             if(estkm1p -> s != SSG_ABS)
  1062.                 etopseg = estkm1p -> s;
  1063.  
  1064.             switch(enode[esub].op)
  1065.             {
  1066. #include "fraebin.h"
  1067.             }
  1068.         }
  1069.         break;
  1070.  
  1071.     case  PCCASE_DEF:
  1072.         if(enode[esub].sym -> seg > 0)
  1073.         {
  1074.             polnumout(1L);
  1075.             etop = 1;
  1076.             etopseg = SSG_ABS;
  1077.         }
  1078.         else
  1079.         {
  1080.             polnumout(0L);
  1081.             etop = 0;
  1082.             etopseg = SSG_ABS;
  1083.         }
  1084.         break;
  1085.  
  1086.     case  PCCASE_SYMB:
  1087.         etop = (enode[esub].sym) -> value;
  1088.         etopseg = (enode[esub].sym) -> seg;
  1089.         if(etopseg == SSG_EQU ||
  1090.            etopseg == SSG_SET ) 
  1091.         {
  1092.             etopseg = SSG_ABS;
  1093.             polnumout((unsigned long)(enode[esub].sym) -> value);
  1094.         }
  1095.         else
  1096.         {
  1097.             polnumout((unsigned long)(enode[esub].sym) -> symnum);
  1098.             polout(IFC_SYMB);
  1099.         }
  1100.         break;
  1101.             
  1102.     case  PCCASE_PROGC:
  1103.         polout(IFC_PROGCTR);
  1104.         etop = locctr;
  1105.         etopseg = SSG_ABS;
  1106.         break;
  1107.             
  1108.     case  PCCASE_CONS:
  1109.         polnumout((unsigned long)enode[esub].val);
  1110.         etop = enode[esub].val;
  1111.         etopseg = SSG_ABS;
  1112.         break;
  1113.  
  1114.     }
  1115.     return TRUE;
  1116. }
  1117.